home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH3 / SRC / FRMSCALE.FRM < prev    next >
Text File  |  1996-01-31  |  4KB  |  142 lines
  1. VERSION 4.00
  2. Begin VB.Form FrmScaleForm 
  3.    Caption         =   "FrmScale"
  4.    ClientHeight    =   3405
  5.    ClientLeft      =   2640
  6.    ClientTop       =   1635
  7.    ClientWidth     =   3405
  8.    Height          =   4095
  9.    Left            =   2580
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3405
  12.    ScaleWidth      =   3405
  13.    Top             =   1005
  14.    Width           =   3525
  15.    Begin VB.Menu mnuFile 
  16.       Caption         =   "&File"
  17.       Begin VB.Menu mnuFilePrint 
  18.          Caption         =   "&Print"
  19.       End
  20.       Begin VB.Menu mnuFileSep 
  21.          Caption         =   "-"
  22.       End
  23.       Begin VB.Menu mnuFileExit 
  24.          Caption         =   "E&xit"
  25.       End
  26.    End
  27. End
  28. Attribute VB_Name = "FrmScaleForm"
  29. Attribute VB_Creatable = False
  30. Attribute VB_Exposed = False
  31. Option Explicit
  32.  
  33. ' ************************************************
  34. ' Draw a Bowditch curve on the indicated object.
  35. ' ************************************************
  36. Sub DrawPicture(obj As Object)
  37. Const PI = 3.14159
  38.  
  39. Dim x As Integer
  40. Dim y As Integer
  41. Dim t As Single
  42. Dim maxt As Single
  43. Dim dt As Single
  44.     
  45.     ' Draw the curve.
  46.     maxt = PI * 8
  47.     dt = maxt / 200
  48.     obj.CurrentX = 0
  49.     obj.CurrentY = 0
  50.     For t = dt To maxt + dt / 2 Step dt
  51.         obj.Line -(Sin(0.75 * t), Sin(t))
  52.     Next t
  53. End Sub
  54.  
  55.  
  56. ' ************************************************
  57. ' Set the printer's scale properties so it will
  58. ' print the object as large as possible, centered
  59. ' in the printable area.
  60. ' ************************************************
  61. Sub SetLargePrinterScale(obj As Object)
  62. Dim owid As Single
  63. Dim ohgt As Single
  64. Dim pwid As Single
  65. Dim phgt As Single
  66. Dim xmid As Single
  67. Dim ymid As Single
  68. Dim s As Single
  69.  
  70.     ' Get the object's size in twips.
  71.     owid = obj.ScaleX(obj.ScaleWidth, obj.ScaleMode, vbTwips)
  72.     ohgt = obj.ScaleY(obj.ScaleHeight, obj.ScaleMode, vbTwips)
  73.     
  74.     ' Get the printer's size in twips.
  75.     pwid = Printer.ScaleX(Printer.ScaleWidth, Printer.ScaleMode, vbTwips)
  76.     phgt = Printer.ScaleY(Printer.ScaleHeight, Printer.ScaleMode, vbTwips)
  77.     
  78.     ' Compare the object and printer aspect ratios.
  79.     If ohgt / owid > phgt / pwid Then
  80.         ' The object is relatively tall and thin.
  81.         ' Use the printer's whole height.
  82.         s = phgt / ohgt ' This is the scale factor.
  83.     Else
  84.         ' The object is relatively short and wide.
  85.         ' Use the printer's whole width.
  86.         s = pwid / owid ' This is the scale factor.
  87.     End If
  88.     
  89.     ' Convert the printer's dimensions into scaled
  90.     ' object coordinates.
  91.     pwid = obj.ScaleX(pwid, vbTwips, obj.ScaleMode) / s
  92.     phgt = obj.ScaleY(phgt, vbTwips, obj.ScaleMode) / s
  93.     
  94.     ' See where the center should be.
  95.     xmid = obj.ScaleLeft + obj.ScaleWidth / 2
  96.     ymid = obj.ScaleTop + obj.ScaleHeight / 2
  97.     
  98.     ' Pass the coordinates of the upper left and
  99.     ' lower right corners into the Scale method.
  100.     Printer.Scale _
  101.         (xmid - pwid / 2, ymid - phgt / 2)- _
  102.         (xmid + pwid / 2, ymid + phgt / 2)
  103. End Sub
  104.  
  105.  
  106. ' ************************************************
  107. ' Draw the picture on the form.
  108. ' ************************************************
  109. Private Sub Form_Paint()
  110.     DrawPicture Me
  111. End Sub
  112.  
  113. ' ************************************************
  114. ' Reset the form scale properties so the picture
  115. ' fills the whole form.
  116. ' ************************************************
  117. Private Sub Form_Resize()
  118.     Me.Scale (-1.1, -1.1)-(1.1, 1.1)
  119.     Me.Refresh
  120. End Sub
  121.  
  122.  
  123. Private Sub mnuFileExit_Click()
  124.     Unload Me
  125. End Sub
  126.  
  127.  
  128. ' ***********************************************
  129. ' Draw the picture on the Printer object.
  130. ' ***********************************************
  131. Private Sub mnuFilePrint_Click()
  132.     MousePointer = vbHourglass
  133.     DoEvents
  134.     
  135.     SetLargePrinterScale Me ' Set scale properties.
  136.     DrawPicture Printer     ' Draw the picture.
  137.     Printer.EndDoc
  138.  
  139.     MousePointer = vbDefault
  140. End Sub
  141.  
  142.